home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1997 / MacHack 1997.toast / Hacks / Hacks ’94 / [√] Distribution Restricted! / Christian Ruse / Fourier Paper + Apps / nih-image154_source.sea / V1.54 Source / Functions.p < prev    next >
Text File  |  1993-10-14  |  50KB  |  1,896 lines
  1. unit Functions;
  2.  
  3. {}
  4.  
  5. interface
  6.  
  7.  
  8.     uses
  9.         QuickDraw, Palettes, PrintTraps, globals, Utilities, Graphics, File1, File2, Analysis, Camera, Lut;
  10.  
  11.  
  12.     procedure ApplyTable (var table: LookupTable);
  13.     procedure ApplyLookupTable;
  14.     procedure MakeBinary;
  15.     procedure Filter (ftype: FilterType; pass: integer; var table: FateTable);
  16.     procedure PhotoMode;
  17.     function AllSameSize: boolean;
  18.     procedure EnhanceContrast;
  19.     procedure EqualizeHistogram;
  20.     procedure Convolve (name: str255; RefNum: integer);
  21.     procedure ConvolveUsingText;
  22.     procedure PlotSurface;
  23.     procedure MakeSkeleton;
  24.     procedure DoErosion;
  25.     procedure DoDilation;
  26.     procedure DoOpening;
  27.     procedure DoClosing;
  28.     procedure SetBinaryCount;
  29.     procedure SetIterations;
  30.     procedure ChangeValues (v1, v2, v3: integer);
  31.     procedure DoPropagate (MenuItem: integer);
  32.     procedure DoArithmetic (MenuItem: integer; constant: extended);
  33.     procedure NewPlotSurface;
  34.     procedure AutoThreshold;
  35.     procedure AutoDensitySlice;
  36.     procedure FixColors;
  37.     procedure DoImageMath;
  38.  
  39.  
  40. implementation
  41.  
  42.     const
  43.         MaxW = 4000;
  44.         Src1Item = 7;
  45.         Src2Item = 8;
  46.         OpItem = 9;
  47.  
  48.     type
  49.         ktype = array[0..MaxW] of integer;
  50.         SortArray = array[1..9] of integer;
  51.  
  52.     var
  53.         PixelsRemoved: LongInt;
  54.         Src1PicNum, Src2PicNum: integer;
  55.  
  56.     procedure ApplyTableToLine (data: ptr; var table: LookupTable; width: LongInt);
  57. {$IFC false}
  58.         var
  59.             line: LinePtr;
  60.             i: integer;
  61.     begin
  62.         line := LinePtr(data);
  63.         for i := 0 to width - 1 do
  64.             Line^[i] := table[Line^[i]];
  65.     end;
  66. {$ENDC}
  67.  
  68. {a0 = data}
  69. {a1 = lookup table}
  70. {d0 = width }
  71. {d1 = pixel value}
  72. inline
  73.     $4E56, $0000, {  link a6,#0}
  74.     $48E7, $C0C0, {  movem.l a0-a1/d0-d1,-(sp)}
  75.     $206E, $000C, {  move.l 12(a6),a0}
  76.     $226E, $0008, {  move.l 8(a6),a1}
  77.     $202E, $0004, {  move.l 4(a6),d0}
  78.     $5380,       {  subq.l #1,d0}
  79.     $4281,       {  clr.l d1}
  80.     $1210,       {L move.b (a0),d1}
  81.     $10F1, $1000, {  move.b 0(a1,d1.w),(a0)+}
  82.     $51C8, $FFF8, {  dbra d0,L}
  83.     $4CDF, $0303, {  movem.l (sp)+,a0-a1/d0-d1}
  84.     $4E5E,       {  unlk a6}
  85.     $DEFC, $000C; {  add.w #12,sp}
  86.  
  87.  
  88. procedure PutLineUsingMask (h, v, count: integer; var line: LineType);
  89.     var
  90.         aLine, MaskLine: LineType;
  91.         i: integer;
  92.         SaveInfo: InfoPtr;
  93. begin
  94.     if count > MaxLine then
  95.         count := MaxLine;
  96.     GetLine(h, v, count, aline);
  97.     SaveInfo := Info;
  98.     Info := UndoInfo;
  99.     GetLine(h, v, count, MaskLine);
  100.     for i := 0 to count - 1 do
  101.         if MaskLine[i] = BlackIndex then
  102.             aLine[i] := line[i];
  103.     info := SaveInfo;
  104.     PutLine(h, v, count, aLine);
  105. end;
  106.  
  107.  
  108. procedure ApplyTable; {(var table: LookupTable)}
  109.     var
  110.         width, NumberOfLines, i, hloc, vloc: integer;
  111.         offset: LongInt;
  112.         p: ptr;
  113.         UseMask: boolean;
  114.         TempLine: LineType;
  115.         AutoSelectAll: boolean;
  116. begin
  117.     if NotInBounds then
  118.         exit(ApplyTable);
  119.     StopDigitizing;
  120.     AutoSelectAll := not Info^.RoiShowing;
  121.     if AutoSelectAll then
  122.         SelectAll(false);
  123.     if TooWide then
  124.         exit(ApplyTable);
  125.     ShowWatch;
  126.     with info^.RoiRect, info^ do begin
  127.             if RoiType <> RectRoi then
  128.                 UseMask := SetupMask
  129.             else
  130.                 UseMask := false;
  131.             SetupUndoFromClip;
  132.             WhatToUndo := UndoTransform;
  133.             offset := LongInt(top) * BytesPerRow + left;
  134.             if UseMask then
  135.                 p := @TempLine
  136.             else
  137.                 p := ptr(ord4(PicBaseAddr) + offset);
  138.             width := right - left;
  139.             NumberOfLines := bottom - top;
  140.             hloc := left;
  141.             vloc := top;
  142.         end;
  143.     if width > 0 then
  144.         for i := 1 to NumberOfLines do
  145.             if UseMask then begin
  146.                     GetLine(hloc, vloc, width, TempLine);
  147.                     ApplyTableToLine(p, table, width);
  148.                     PutLineUsingMask(hloc, vloc, width, TempLine);
  149.                     vloc := vloc + 1
  150.                 end
  151.             else begin
  152.                     ApplyTableToLine(p, table, width);
  153.                     p := ptr(ord4(p) + info^.BytesPerRow);
  154.                 end;
  155.     with info^ do begin
  156.             UpdateScreen(RoiRect);
  157.             Info^.changes := true;
  158.         end;
  159.     SetupRoiRect;
  160.     if AutoSelectAll then
  161.         KillRoi;
  162. end;
  163.  
  164.  
  165. function DoApplyTableDialogBox: boolean;
  166.     const
  167.         Button1 = 3;
  168.         Button2 = 4;
  169.         Button3 = 5;
  170.         Button4 = 6;
  171.     var
  172.         mylog: DialogPtr;
  173.         item: integer;
  174.         SaveA, SaveB: boolean;
  175.  
  176.     procedure SetButtons;
  177.     begin
  178.         SetDialogItem(mylog, Button1, ord(ThresholdToForeground));
  179.         SetDialogItem(mylog, Button2, ord(not ThresholdToForeground));
  180.         SetDialogItem(mylog, Button3, ord(NonThresholdToBackground));
  181.         SetDialogItem(mylog, Button4, ord(not NonThresholdToBackground));
  182.     end;
  183.  
  184. begin
  185.     InitCursor;
  186.     SaveA := ThresholdToForeground;
  187.     SaveB := NonThresholdToBackground;
  188.     mylog := GetNewDialog(40, nil, pointer(-1));
  189.     SetButtons;
  190.     OutlineButton(MyLog, ok, 16);
  191.     repeat
  192.         ModalDialog(nil, item);
  193.         if (item = Button1) or (item = button2) then begin
  194.                 ThresholdToForeground := not ThresholdToForeground;
  195.                 SetButtons;
  196.             end;
  197.         if (item = Button3) or (item = button4) then begin
  198.                 NonThresholdToBackground := not NonThresholdToBackground;
  199.                 SetButtons;
  200.             end;
  201.     until (item = ok) or (item = cancel);
  202.     DisposDialog(mylog);
  203.     if item = cancel then begin
  204.             ThresholdToForeground := SaveA;
  205.             NonThresholdToBackground := SaveB;
  206.             DoApplyTableDialogBox := false
  207.         end
  208.     else
  209.         DoApplyTableDialogBox := true;
  210. end;
  211.  
  212.  
  213. procedure ApplyLookupTable;
  214.     var
  215.         table: LookupTable;
  216.         ConvertingColorPic, GrayScaleImage: boolean;
  217.         i: integer;
  218. begin
  219.     with info^ do begin
  220.             GrayScaleImage := (LUTMode = Grayscale) or (LUTMode = CustomGrayscale);
  221.             ConvertingColorPic := not GrayScaleImage and not DensitySlicing;
  222.             if ConvertingColorPic then
  223.                 KillRoi;
  224.             if DensitySlicing and (not macro) then begin
  225.                     if not DoApplyTableDialogBox then
  226.                         exit(ApplyLookupTable);
  227.                 end;
  228.             if thresholding then
  229.                 BinaryPic := true;
  230.             GetLookupTable(table);
  231.             if GrayscaleImage or ConvertingColorPic then
  232.                 ResetGrayMap;
  233.             ApplyTable(table);
  234.             if ConvertingColorPic then
  235.                 WhatToUndo := NothingToUndo;
  236.             if DensityCalibrated then begin
  237.                     DensityCalibrated := false;
  238.                     for i := 0 to 255 do
  239.                         cvalue[i] := i;
  240.                 end;
  241.         end; {with}
  242. end;
  243.  
  244.  
  245. procedure MakeBinary;
  246.     var
  247.         table: LookupTable;
  248.         SaveBackground, SaveForeground, i: integer;
  249. begin
  250.     with info^ do begin
  251.             if DensitySlicing then begin
  252.                     ThresholdToForeground := true;
  253.                     NonThresholdToBackground := true;
  254.                     SaveBackground := BackgroundIndex;
  255.                     SaveForeground := ForegroundIndex;
  256.                     BackgroundIndex := WhiteIndex;
  257.                     ForegroundIndex := BlackIndex;
  258.                     GetLookupTable(table);
  259.                     ResetGrayMap;
  260.                     ApplyTable(table);
  261.                     BackgroundIndex := SaveBackground;
  262.                     ForegroundIndex := SaveForeground;
  263.                     BinaryPic := true;
  264.                 end
  265.             else if Thresholding then begin
  266.                     for i := 0 to 255 do
  267.                         if i < ColorStart then
  268.                             table[i] := WhiteIndex
  269.                         else
  270.                             table[i] := BlackIndex;
  271.                     ResetGrayMap;
  272.                     ApplyTable(table);
  273.                     BinaryPic := true;
  274.                 end
  275.             else
  276.                 PutMessage('Sorry, but you must be thresholding or density slicing to use Make Binary.');
  277.         end;
  278. end;
  279.  
  280.  
  281. {$IFC false}
  282. function FindMedian (var a: SortArray): integer;
  283.   {Finds the 5th largest of 9 values}
  284.     var
  285.         i, j, mj, max: integer;
  286. begin
  287.     for i := 1 to 4 do begin
  288.             max := 0;
  289.             mj := 1;
  290.             for j := 1 to 9 do
  291.                 if a[j] > max then begin
  292.                         max := a[j];
  293.                         mj := j;
  294.                     end;
  295.             a[mj] := 0;
  296.         end;
  297.     max := 0;
  298.     for j := 1 to 9 do
  299.         if a[j] > max then
  300.             max := a[j];
  301.     FindMedian := max;
  302. end;
  303. {$ENDC}
  304.  
  305. function FindMedian (var a: sortArray): integer;
  306.    {In-line code contributed by Edward J. Huff(huff@mcclbo.med.nyu.edu).}
  307.    {Assember source with comments and a test program are available by anonymous}
  308.    {ftp from zippy.nimh.nih.gov, in the /pub/nih-image/documents directory.}
  309. inline
  310.     $205F, $48E7, $1F00, $4C98, $00FF, $B041, $6502, $C340,{}
  311.     $B443, $6502, $C742, $B243, $6504, $C540, $C741, $B845,{}
  312.     $6502, $CB44, $BC47, $6502, $CF46, $BA47, $6504, $CD44,{}
  313.     $CF45, $B245, $6508, $CF43, $CD42, $CB41, $C940, $3E10,{}
  314.     $BC47, $6502, $CF46, $BA47, $6504, $CD44, $CF45, $B245,{}
  315.     $6508, $CF43, $CD42, $CB41, $C940, $B246, $6534, $B242,{}
  316.     $6514, $B244, $6504, $3001, $6062, $B644, $6504, $3004,{}
  317.     $605A, $3003, $6056, $B444, $650C, $B445, $6504, $3005,{}
  318.     $604A, $3002, $6046, $B644, $6504, $3004, $603E, $3003,{}
  319.     $603A, $B645, $6504, $C942, $CB43, $B846, $651C, $B644,{}
  320.     $650C, $B444, $6504, $3002, $6022, $3004, $601E, $B646,{}
  321.     $6504, $3003, $6016, $3006, $6012, $B646, $6508, $B446,{}
  322.     $65F4, $3002, $6006, $B644, $65E0, $3003, $4CDF, $00F8,{}
  323.     $3E80;
  324.  
  325.  
  326. procedure Filter (ftype: FilterType; pass: integer; var table: FateTable);
  327.     const
  328.         PixelsPerUpdate = 5000;
  329.     var
  330.         row, width, r1, r2, r3, c, value, error, sum, center: integer;
  331.         tmp, mark, NewMark, LinesPerUpdate, LineCount: integer;
  332.         t1, t2, t3, t4: integer;
  333.         MaskRect, frame, trect: rect;
  334.         WhitePixel1: integer;
  335.         L1: LineType;
  336.         WhitePixel2: integer;
  337.         L2: LineType;
  338.         WhitePixel3: integer;
  339.         L3, result: LineType;
  340.         pt: point;
  341.         a: SortArray;
  342.         AutoSelectAll, UseMask, BinaryFilter: boolean;
  343.         L, T, R, B, index, code, FirstRow, LastRow: integer;
  344.         StartTicks: LongInt;
  345. begin
  346.     if NotinBounds then
  347.         exit(Filter);
  348.     StopDigitizing;
  349.     AutoSelectAll := not Info^.RoiShowing;
  350.     if AutoSelectAll then
  351.         with info^ do begin
  352.                 SelectAll(false);
  353.                 SetPort(wptr);
  354.                 PenNormal;
  355.                 PenPat(pat[PatIndex]);
  356.                 FrameRect(wrect);
  357.             end;
  358.     if TooWide then
  359.         exit(Filter);
  360.     ShowWatch;
  361.     if info^.RoiType <> RectRoi then
  362.         UseMask := SetupMask
  363.     else
  364.         UseMask := false;
  365.     if pass = 0 then begin
  366.             SetupUndoFromClip;
  367.             ShowMessage(CmdPeriodToStop);
  368.             WhatToUndo := UndoFilter;
  369.         end;
  370.     frame := info^.RoiRect;
  371.     StartTicks := TickCount;
  372.     BinaryFilter := ftype in [Erosion, Dilation, OutlineFilter, Skeletonize];
  373.     with frame, Info^ do begin
  374.             changes := true;
  375.             RoiShowing := false;
  376.             width := right - left;
  377.             LinesPerUpdate := PixelsPerUpdate div width;
  378.             if ftype = ReduceNoise then
  379.                 LinesPerUpdate := LinesPerUpdate div 3;
  380.             if BinaryFilter then begin
  381.                     FirstRow := top;
  382.                     LastRow := bottom - 1;
  383.                     WhitePixel1 := WhiteIndex;
  384.                     WhitePixel2 := WhiteIndex;
  385.                     WhitePixel3 := WhiteIndex;
  386.                     if width < MaxLine then begin
  387.                             L1[width] := WhiteIndex;
  388.                             L2[width] := WhiteIndex;
  389.                             L3[width] := WhiteIndex;
  390.                         end;
  391.                 end
  392.             else begin
  393.                     FirstRow := top + 1;
  394.                     LastRow := bottom - 2;
  395.                 end;
  396.             GetLine(left, FirstRow - 1, width, L2);
  397.             GetLine(left, FirstRow, width, L3);
  398.             Mark := RoiRect.top;
  399.             LineCount := 0;
  400.             for row := FirstRow to LastRow do begin
  401.        {Move Convolution Window Down}
  402.                     BlockMove(@L2, @L1, width);
  403.                     BlockMove(@L3, @L2, width);
  404.                     GetLine(left, row + 1, width, L3);
  405.        {Process One Row}
  406.                     case ftype of
  407.                         EdgeDetect: 
  408.                             for c := 1 to width - 2 do begin
  409.                                     t1 := L1[c - 1] + L1[c] + L1[c + 1] - L3[c - 1] - L3[c] - L3[c + 1];
  410.                                     t1 := abs(t1);
  411.                                     t2 := L1[c + 1] + L2[c + 1] + L3[c + 1] - L1[c - 1] - L2[c - 1] - L3[c - 1];
  412.                                     t2 := abs(t2);
  413.                                     if t1 > t2 then
  414.                                         tmp := t1
  415.                                     else
  416.                                         tmp := t2;
  417.                                     if OptionKeyWasDown then begin
  418.                                             if tmp > 255 then
  419.                                                 tmp := 255;
  420.                                             if tmp < 0 then
  421.                                                 tmp := 0;
  422.                                         end
  423.                                     else if tmp > 35 then
  424.                                         tmp := 255
  425.                                     else
  426.                                         tmp := 0;
  427.                                     result[c] := tmp;
  428.                                 end;
  429.                         ReduceNoise:  {Median Filter}
  430.                             for c := 1 to width - 2 do begin
  431.                                     a[1] := L1[c - 1];
  432.                                     a[2] := L1[c];
  433.                                     a[3] := L1[c + 1];
  434.                                     a[4] := L2[c - 1];
  435.                                     a[5] := L2[c];
  436.                                     a[6] := L2[c + 1];
  437.                                     a[7] := L3[c - 1];
  438.                                     a[8] := L3[c];
  439.                                     a[9] := L3[c + 1];
  440.                                     result[c] := FindMedian(a);
  441.                                 end;
  442.                         Dither:  {Floyd-Steinberg Algorithm}
  443.                             for c := 1 to width - 2 do begin
  444.                                     value := L2[c];
  445.                                     if value < 128 then begin
  446.                                             result[c] := 0;
  447.                                             error := -value;
  448.                                         end
  449.                                     else begin
  450.                                             result[c] := 255;
  451.                                             error := 255 - value
  452.                                         end;
  453.                                     tmp := L2[c + 1];              {A}
  454.                                     tmp := tmp - (7 * error) div 16;
  455.                                     if tmp < 0 then
  456.                                         tmp := 0;
  457.                                     if tmp > 255 then
  458.                                         tmp := 255;
  459.                                     L2[c + 1] := tmp;
  460.                                     tmp := L3[c + 1];              {B}
  461.                                     tmp := tmp - error div 16;
  462.                                     if tmp < 0 then
  463.                                         tmp := 0;
  464.                                     if tmp > 255 then
  465.                                         tmp := 255;
  466.                                     L3[c + 1] := tmp;
  467.                                     tmp := L3[c];              {C}
  468.                                     tmp := tmp - (5 * error) div 16;
  469.                                     if tmp < 0 then
  470.                                         tmp := 0;
  471.                                     if tmp > 255 then
  472.                                         tmp := 255;
  473.                                     L3[c] := tmp;
  474.                                     tmp := L3[C - 1];                {D}
  475.                                     tmp := tmp - (3 * error) div 16;
  476.                                     if tmp < 0 then
  477.                                         tmp := 0;
  478.                                     if tmp > 255 then
  479.                                         tmp := 255;
  480.                                     L3[C - 1] := tmp;
  481.                                 end;
  482.                         UnweightedAvg: 
  483.                             for c := 1 to width - 2 do begin
  484.                                     tmp := (L1[C - 1] + L1[c] + L1[c + 1] + L2[c - 1] + L2[c] + L2[c + 1] + L3[c - 1] + L3[c] + L3[c + 1]) div 9;
  485.                                     if tmp > 255 then
  486.                                         tmp := 255;
  487.                                     if tmp < 0 then
  488.                                         tmp := 0;
  489.                                     result[c] := tmp;
  490.                                 end;
  491.                         WeightedAvg: 
  492.                             for c := 1 to width - 2 do begin
  493.                                     tmp := (L1[c - 1] + L1[c] + L1[c + 1] + L2[c - 1] + L2[c] * 4 + L2[c + 1] + L3[c - 1] + L3[c] + L3[c + 1]) div 12;
  494.                                     if tmp > 255 then
  495.                                         tmp := 255;
  496.                                     if tmp < 0 then
  497.                                         tmp := 0;
  498.                                     result[c] := tmp;
  499.                                 end;
  500.                         fsharpen: 
  501.                             for c := 1 to width - 2 do begin
  502.                                     if OptionKeyWasDown then
  503.                                         tmp := L2[c] * 9 - L1[c - 1] - L1[c] - L1[c + 1] - L2[c - 1] - L2[c + 1] - L3[c - 1] - L3[c] - L3[c + 1]
  504.                                     else begin
  505.                                             tmp := L2[c] * 12 - L1[c - 1] - L1[c] - L1[c + 1] - L2[c - 1] - L2[c + 1] - L3[c - 1] - L3[c] - L3[c + 1];
  506.                                             tmp := tmp div 4;
  507.                                         end;
  508.                                     if tmp > 255 then
  509.                                         tmp := 255;
  510.                                     if tmp < 0 then
  511.                                         tmp := 0;
  512.                                     result[c] := tmp;
  513.                                 end;
  514.                         fshadow: 
  515.                             for c := 1 to width - 2 do begin
  516.                                     tmp := L2[c + 1] + L2[c + 1] + L3[c] + L3[c + 1] * 2 - L1[c - 1] * 2 - L1[c] - L2[c - 1];
  517.                                     if tmp > 255 then
  518.                                         tmp := 255;
  519.                                     if tmp < 0 then
  520.                                         tmp := 0;
  521.                                     result[c] := tmp;
  522.                                 end;
  523.                         Erosion: 
  524.                             for c := 0 to width - 1 do begin
  525.                                     center := L2[c];
  526.                                     if center = BlackIndex then begin
  527.                                             sum := L1[c - 1] + L1[c] + L1[c + 1] + L2[c - 1] + L2[c + 1] + L3[c - 1] + L3[c] + L3[c + 1];
  528.                                             if (2040 - sum) >= BinaryThreshold then
  529.                                                 center := WhiteIndex;
  530.                                         end;
  531.                                     result[c] := center;
  532.                                 end;
  533.                         Dilation: 
  534.                             for c := 0 to width - 1 do begin
  535.                                     center := L2[c];
  536.                                     if center = WhiteIndex then begin
  537.                                             sum := L1[c - 1] + L1[c] + L1[c + 1] + L2[c - 1] + L2[c + 1] + L3[c - 1] + L3[c] + L3[c + 1];
  538.                                             if sum >= BinaryThreshold then
  539.                                                 center := BlackIndex;
  540.                                         end;
  541.                                     result[c] := center;
  542.                                 end;
  543.                         OutlineFilter: 
  544.                             for c := 0 to width - 1 do begin
  545.                                     center := L2[c];
  546.                                     if center = BlackIndex then begin
  547.                                             if (L2[c - 1] = WhiteIndex) or (L1[c] = WhiteIndex) or (L2[c + 1] = WhiteIndex) or (L3[c] = WhiteIndex) then
  548.                                                 center := BlackIndex
  549.                                             else
  550.                                                 center := WhiteIndex;
  551.                                         end;
  552.                                     result[c] := center;
  553.                                 end;
  554.  
  555.                         Skeletonize: 
  556.                             for c := 0 to width - 1 do begin
  557.                                     center := L2[c];
  558.                                     if center = BlackIndex then begin
  559.                                             index := 0;
  560.                                             if L1[c - 1] = BlackIndex then
  561.                                                 index := bor(index, 1);
  562.                                             if L1[c] = BlackIndex then
  563.                                                 index := bor(index, 2);
  564.                                             if L1[c + 1] = BlackIndex then
  565.                                                 index := bor(index, 4);
  566.                                             if L2[c + 1] = BlackIndex then
  567.                                                 index := bor(index, 8);
  568.                                             if L3[c + 1] = BlackIndex then
  569.                                                 index := bor(index, 16);
  570.                                             if L3[c] = BlackIndex then
  571.                                                 index := bor(index, 32);
  572.                                             if L3[c - 1] = BlackIndex then
  573.                                                 index := bor(index, 64);
  574.                                             if L2[c - 1] = BlackIndex then
  575.                                                 index := bor(index, 128);
  576.                                             code := table[index];
  577.                                             if odd(pass) then begin
  578.                                                     if (code = 2) or (code = 3) then begin
  579.                                                             center := WhiteIndex;
  580.                                                             PixelsRemoved := PixelsRemoved + 1;
  581.                                                         end;
  582.                                                 end
  583.                                             else begin {even pass}
  584.                                                     if (code = 1) or (code = 3) then begin
  585.                                                             center := WhiteIndex;
  586.                                                             PixelsRemoved := PixelsRemoved + 1;
  587.                                                         end;
  588.                                                 end;
  589.                                         end; {if}
  590.                                     result[c] := center;
  591.                                 end; {for}
  592.                     end; {case}
  593.                     if not BinaryFilter then begin
  594.                             result[0] := L2[0];
  595.                             result[width - 1] := L2[width - 1];
  596.                         end;
  597.                     if UseMask then
  598.                         PutLineUsingMask(left, row, width, result)
  599.                     else
  600.                         PutLine(left, row, width, result);
  601.                     LineCount := LineCount + 1;
  602.                     if LineCount = LinesPerUpdate then begin
  603.                             pt.h := RoiRect.left;
  604.                             pt.v := row + 1;
  605.                             NewMark := pt.v;
  606.                             with RoiRect do
  607.                                 SetRect(MaskRect, left, mark, right, NewMark);
  608.                             UpdateScreen(MaskRect);
  609.                             LineCount := 0;
  610.                             Mark := NewMark;
  611.                             if magnification > 1.0 then
  612.                                 Mark := Mark - 1;
  613.                             if CommandPeriod then begin
  614.                                     UpdatePicWindow;
  615.                                     beep;
  616.                                     PixelsRemoved := 0;
  617.                                     if AutoSelectAll then
  618.                                         KillRoi;
  619.                                     exit(filter)
  620.                                 end;
  621.                         end;
  622.                 end; {for row:=...}
  623.             trect := frame;
  624.             InsetRect(trect, 1, 1);
  625.             ShowTime(StartTicks, trect, '');
  626.         end; {with}
  627.     if LineCount > 0 then begin
  628.             with frame do
  629.                 SetRect(MaskRect, left, mark, right, bottom);
  630.             UpdateScreen(MaskRect)
  631.         end;
  632.     SetupRoiRect;
  633.     if AutoSelectAll then
  634.         KillRoi;
  635. end;
  636.  
  637.  
  638. procedure PhotoMode;
  639. {Erases the screen to the background color and then redraws}
  640. {the contents of the active image window . }
  641.     var
  642.         tPort: GrafPtr;
  643.         event: EventRecord;
  644.         WinRect: rect;
  645.         SaveVisRgn: rgnHandle;
  646. begin
  647.     with info^ do begin
  648.             KillRoi;
  649.             if OptionKeyWasDown then begin {Move window up to top of screen.}
  650.                     GetWindowRect(wptr, WinRect);
  651.                     MoveWindow(wptr, WinRect.left, 0, false);
  652.                 end;
  653.             with wptr^ do begin
  654.                     SaveVisRgn := visRgn;
  655.                     visRgn := NewRgn;
  656.                     RectRgn(visRgn, ScreenBits.Bounds);
  657.                 end;
  658.             FlushEvents(EveryEvent, 0);
  659.             GetPort(tPort);
  660.             EraseScreen;
  661.             UpdatePicWindow;
  662.             repeat
  663.             until WaitNextEvent(mDownMask + KeyDownMask, Event, 5, nil);
  664.             with wptr^ do begin
  665.                     DisposeRgn(visRgn);
  666.                     visRgn := SaveVisRgn;
  667.                 end;
  668.             RestoreScreen;
  669.             SetPort(tPort);
  670.             FlushEvents(EveryEvent, 0);
  671.             if OptionKeyWasDown then begin
  672.                     MoveWindow(wptr, WinRect.left, WinRect.top, false);
  673.                 end;
  674.         end;
  675. end;
  676.  
  677.  
  678. function AllSameSize: boolean;
  679. {Returns true if all currently open Images have the same dimensions.}
  680.     var
  681.         i: integer;
  682.         SameSize: Boolean;
  683.         TempInfo: InfoPtr;
  684. begin
  685.     if nPics = 0 then begin
  686.             AllSameSize := false;
  687.             exit(AllSameSize);
  688.         end;
  689.     SameSize := true;
  690.     for i := 1 to nPics do begin
  691.             TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
  692.             SameSize := SameSize and EqualRect(Info^.PicRect, TempInfo^.PicRect);
  693.         end;
  694.     AllSameSize := SameSize;
  695. end;
  696.  
  697.  
  698. procedure EnhanceContrast;
  699.     var
  700.         AutoSelectAll: boolean;
  701.         min, max, i, threshold: integer;
  702.         found, SaveRedirectFlag: boolean;
  703.         sum: LongInt;
  704. begin
  705.     with info^ do
  706.         if LUTMode = ColorLUT then begin
  707.                 PutMessage('Sorry, but you can not contrast enhance true color images.');
  708.                 exit(EnhanceContrast)
  709.             end;
  710.     if NotInBounds or (ClipBuf = nil) then
  711.         exit(EnhanceContrast);
  712.     StopDigitizing;
  713.     AutoSelectAll := not Info^.RoiShowing;
  714.     if AutoSelectAll then
  715.         SelectAll(false);
  716.     SaveRedirectFlag := RedirectSampling;
  717.     RedirectSampling := false;
  718.     if info^.RoiType = RectRoi then
  719.         GetRectHistogram
  720.     else
  721.         GetHistogram;
  722.     RedirectSampling := SaveRedirectFlag;
  723.     sum := 0;
  724.     for i := 0 to 255 do
  725.         sum := sum + histogram[i];
  726.     threshold := sum div 5000;
  727.     i := -1;
  728.     repeat
  729.         i := i + 1;
  730.         found := histogram[i] > threshold;
  731.     until found or (i = 255);
  732.     min := i;
  733.     i := 256;
  734.     repeat
  735.         i := i - 1;
  736.         found := histogram[i] > threshold;
  737.     until found or (i = 0);
  738.     max := i;
  739.     if max > min then
  740.         with info^ do begin
  741.                 SetupLutUndo;
  742.                 if isGrayScaleLUT then
  743.                     LUTMode := grayscale;
  744.                 ColorStart := min;
  745.                 ColorEnd := max;
  746.                 DrawMap;
  747.                 UpdateLUT;
  748.                 changes := true;
  749.                 IdentityFunction := false;
  750.             end;
  751.     if AutoSelectAll then
  752.         KillRoi;
  753. end;
  754.  
  755.  
  756. procedure EqualizeHistogram;
  757.     var
  758.         AutoSelectAll, SaveRedirectFlag: boolean;
  759.         i, sum, v: integer;
  760.         isum: LongInt;
  761.         ScaleFactor: extended;
  762. begin
  763.     with info^ do
  764.         if (LUTMode <> GrayScale) and (LutMode <> CustomGrayscale) then begin
  765.                 PutMessage('Sorry, but you can only do histogram equalization on grayscale images.');
  766.                 exit(EqualizeHistogram)
  767.             end;
  768.     if NotInBounds or (ClipBuf = nil) then
  769.         exit(EqualizeHistogram);
  770.     StopDigitizing;
  771.     AutoSelectAll := not Info^.RoiShowing;
  772.     if AutoSelectAll then
  773.         SelectAll(false);
  774.     SaveRedirectFlag := RedirectSampling;
  775.     RedirectSampling := false;
  776.     if info^.RoiType = RectRoi then
  777.         GetRectHistogram
  778.     else
  779.         GetHistogram;
  780.     RedirectSampling := SaveRedirectFlag;
  781.     FindThresholdingMode;
  782.     ComputeResults;
  783.     isum := 0;
  784.     for i := 0 to 255 do
  785.         isum := isum + histogram[i];
  786.     ScaleFactor := 255.0 / isum;
  787.     sum := 0;
  788.     with info^ do begin
  789.             SetupLutUndo;
  790.             for i := 255 downto 0 do
  791.                 with cTable[i].rgb do begin
  792.                         sum := round(sum + histogram[i] * ScaleFactor);
  793.                         if sum > 255 then
  794.                             sum := 255;
  795.                         v := sum * 256;
  796.                         red := v;
  797.                         green := v;
  798.                         blue := v;
  799.                     end;
  800.             LoadLUT(cTable);
  801.             LUTMode := CustomGrayscale;
  802.             SetupPseudocolor;
  803.             changes := true;
  804.             DrawMap;
  805.             IdentityFunction := false;
  806.         end; {with info}
  807.     if AutoSelectAll then
  808.         KillRoi;
  809. end;
  810.  
  811.  
  812. procedure GetKernel (var kernel: ktype; var n: integer; var name: str255; RefNum: integer);
  813.     var
  814.         rLine: rLineType;
  815.         i, count, nValues, nRows: integer;
  816. begin
  817.     count := 0;
  818.     nRows := 0;
  819.     InitTextInput(name, RefNum);
  820.     while not TextEof and (nRows <= 63) do begin
  821.             GetLineFromText(rLine, nValues);
  822.             if count <> 0 then
  823.                 nRows := nRows + 1;
  824.             if nRows = 1 then
  825.                 n := nValues;
  826.             for i := 1 to nValues do begin
  827.                     count := count + 1;
  828.                     kernel[count - 1] := round(rLine[i]);
  829.                 end;
  830.         end;
  831.     if count <> (n * n) then
  832.         n := 0;
  833. end;
  834.  
  835.  
  836. procedure DoOnePixel (nLess1, BytesPerLine: integer; corner: LongInt; var sum: LongInt; var kernel: ktype);
  837. {$IFC false}
  838.     var
  839.         row, column, k: integer;
  840.         pp: ptr;
  841. begin
  842.     k := 0;
  843.     sum := 0;
  844.     for row := 0 to nless1 do begin
  845.             corner := corner + BytesPerLine;
  846.             pp := ptr(corner);
  847.             for column := 0 to nless1 do begin
  848.                     sum := sum + band(pp^, 255) * kernel[k];
  849.                     k := k + 1;
  850.                     pp := ptr(ord(pp) + 1);
  851.                 end;
  852.         end;
  853. end;
  854. {$ENDC}
  855.  
  856. {a0=^corner/^sum}
  857. {a1=^kernel}
  858. {a2=^pixels}
  859.  
  860. {d0=n-1}
  861. {d1=BytesPerLine}
  862. {d2=sum}
  863. {d3=n-1(outer loop)}
  864. {d4=n-1(inner loop)}
  865. {d5=temp}
  866.  
  867. inline
  868.     $4E56, $0000, {  link    a6,#0}
  869.     $48E7, $FCE0,  {  movem.l    a0-a2/d0-d5,-(sp)}
  870.     $4280,              {  clr.l    d0}
  871.     $302E, $0012, {  move.w    18(a6),d0}
  872.     $4281,              {  clr.l    d1}
  873.     $322E, $0010, {  move.w    16(a6),d1}
  874.     $206E, $000C, {  movea.l    12(a6),a0}
  875.     $226E, $0004, {  movea.l    4(a6),a1}
  876.  
  877.     $4282,             {  clr.l    d2}
  878.     $2600,             {  move.l    d0,d3}
  879.  
  880.     $D1C1,             {A adda.l    d1,a0}
  881.     $2448,            {  move.l    a0,a2}
  882.     $2800,            {  move.l    d0,d4}
  883.     $4285,            {B clr.l    d5                   (2)}
  884.     $1A1A,             {  move.b    (a2)+,d5    (6) }
  885.     $CBD9,             {  muls    (a1)+,d5     (29!)}
  886.     $D485,             {  add.l    d5,d2          (2)}
  887.     $51CC, $FFF6, {  dbra    d4,B                (6)}
  888.     $51CB, $FFEC, {  dbra    d3,A}
  889.  
  890.     $206E, $0008, {  move.l    8(a6),a0}
  891.     $2082,              {  move.l    d2,(a0)}
  892.     $4CDF, $073F, {  movem.l    (sp)+,a0-a2/d0-d5}
  893.     $4E5E,              {  unlk    a6}
  894.     $DEFC, $0010; {  add.w    #16,sp}
  895.  
  896.  
  897.  
  898. procedure DoConvolution (var kernel: ktype; n: integer);
  899.     const
  900.         skip = 7;
  901.     var
  902.         row, width, column, value, error: integer;
  903.         margin, i, nless1: integer;
  904.         frame, MaskRect, tRect: rect;
  905.         AutoSelectAll, ScalingNeeded: boolean;
  906.         SrcCenter, DstCenter, sum, max, offset, wsum, cscale, StartTicks: LongInt;
  907.         MinResult, MaxResult: LongInt;
  908.         p: ptr;
  909.         str, str2: str255;
  910.         ScaleFactor: extended;
  911. begin
  912.     if NotinBounds or NotRectangular then
  913.         exit(DoConvolution);
  914.     StopDigitizing;
  915.     AutoSelectAll := not Info^.RoiShowing;
  916.     if AutoSelectAll then
  917.         SelectAll(false);
  918.     SetupUndoFromClip;
  919.     WhatToUndo := UndoFilter;
  920.     frame := info^.RoiRect;
  921.     with frame, Info^ do begin
  922.             if ((LutMode = GrayScale) or (LutMode = CustomGrayscale)) and (not IdentityFunction) then
  923.                 ApplyLookupTable;
  924.             changes := true;
  925.             margin := n div 2;
  926.             if left < margin then
  927.                 left := left + margin;
  928.             if right > (PicRect.right - margin) then
  929.                 right := right - margin;
  930.             if top < margin then
  931.                 top := top + margin;
  932.             if bottom > (PicRect.bottom - margin) then
  933.                 bottom := bottom - margin;
  934.             SetPort(wptr);
  935.             PenNormal;
  936.             PenPat(pat[PatIndex]);
  937.             tRect := frame;
  938.             OffscreenToScreenRect(tRect);
  939.             FrameRect(tRect);
  940.             width := right - left;
  941.             max := n * n - 1;
  942.             wsum := 0;
  943.             for i := 0 to max do
  944.                 wsum := wsum + kernel[i];
  945.             NumToString(n, str);
  946.             NumToString(wsum, str2);
  947.             ValuesMessage := Concat(str, ' x ', str, ' kernel', cr, 'sum = ', str2, cr, cr, CmdPeriodToStop);
  948.             ShowValues;
  949.             if wsum <> 0 then
  950.                 cscale := wsum
  951.             else
  952.                 cscale := 1;
  953.             offset := -(n div 2) * BytesPerRow - BytesPerRow - n div 2;
  954.             nless1 := n - 1;
  955.             StartTicks := TickCount;
  956.             str := '';
  957.             if ScaleConvolutions then begin
  958.                     MinResult := MaxLongInt;
  959.                     MaxResult := -MaxLongInt;
  960.                     row := top;
  961.                     while row < bottom do begin
  962.                             SrcCenter := ord4(ClipBufInfo^.PicBaseAddr) + LongInt(row) * BytesPerRow + left;
  963.                             column := left;
  964.                             while column < (left + width) do begin
  965.                                     DoOnePixel(nless1, BytesPerRow, SrcCenter + offset, sum, kernel);
  966.                                     value := sum div cscale;
  967.                                     if value < MinResult then
  968.                                         MinResult := value;
  969.                                     if value > MaxResult then
  970.                                         MaxResult := value;
  971.                                     SrcCenter := SrcCenter + skip;
  972.                                     column := column + skip;
  973.                                 end; {while column}
  974.                             row := row + skip;
  975.                         end; {while row...}
  976.                     ScalingNeeded := (MinResult < 0) or (MaxResult > 255);
  977.                     if ScalingNeeded then
  978.                         ScaleFactor := 253.0 / (MaxResult - MinResult)
  979.                     else
  980.                         ScaleFactor := 1.0;
  981.                     RealToString(ScaleFactor, 1, 4, str);
  982.                     str := concat('min=', long2str(MinResult), cr, 'max=', long2str(MaxResult), cr, 'scale factor= ', str);
  983.                     for row := top to bottom - 1 do begin
  984.                             SrcCenter := ord4(ClipBufInfo^.PicBaseAddr) + LongInt(row) * BytesPerRow + left;
  985.                             DstCenter := ord4(PicBaseAddr) + LongInt(row) * BytesPerRow + left;
  986.                             for column := left to left + width - 1 do begin
  987.                                     DoOnePixel(nless1, BytesPerRow, SrcCenter + offset, sum, kernel);
  988.                                     value := sum div cscale;
  989.                                     if ScalingNeeded then begin
  990.                                             if value < MinResult then
  991.                                                 value := MinResult;
  992.                                             if value > MaxResult then
  993.                                                 value := MaxResult;
  994.                                             value := round((value - MinResult) * ScaleFactor + 1);
  995.                                         end;
  996.                                     p := ptr(DstCenter);
  997.                                     p^ := BAND(value, 255);
  998.                                     SrcCenter := SrcCenter + 1;
  999.                                     DstCenter := DstCenter + 1;
  1000.                                 end; {for column:=}
  1001.                             SetRect(MaskRect, left, row, right, row + 1);
  1002.                             UpdateScreen(MaskRect);
  1003.                             if CommandPeriod then begin
  1004.                                     UpdatePicWindow;
  1005.                                     beep;
  1006.                                     exit(DoConvolution)
  1007.                                 end;
  1008.                         end; {for row:=...}
  1009.                 end  {Scale Convolutions}
  1010.             else
  1011.                 for row := top to bottom - 1 do begin
  1012.                         SrcCenter := ord4(ClipBufInfo^.PicBaseAddr) + LongInt(row) * BytesPerRow + left;
  1013.                         DstCenter := ord4(PicBaseAddr) + LongInt(row) * BytesPerRow + left;
  1014.                         for column := left to left + width - 1 do begin
  1015.                                 DoOnePixel(nless1, BytesPerRow, SrcCenter + offset, sum, kernel);
  1016.                                 value := sum div cscale;
  1017.                                 if value < MinResult then
  1018.                                     MinResult := value;
  1019.                                 if value > MaxResult then
  1020.                                     MaxResult := value;
  1021.                                 if value > 255 then
  1022.                                     value := 255;
  1023.                                 if value < 0 then
  1024.                                     value := 0;
  1025.                                 p := ptr(DstCenter);
  1026.                                 p^ := BAND(value, 255);
  1027.                                 SrcCenter := SrcCenter + 1;
  1028.                                 DstCenter := DstCenter + 1;
  1029.                             end; {for column:=}
  1030.                         SetRect(MaskRect, left, row, right, row + 1);
  1031.                         UpdateScreen(MaskRect);
  1032.                         if CommandPeriod then begin
  1033.                                 UpdatePicWindow;
  1034.                                 beep;
  1035.                                 exit(DoConvolution)
  1036.                             end;
  1037.                     end; {for row:=...}
  1038.             ShowTime(StartTicks, frame, str);
  1039.         end; {with}
  1040.     UpdatePicWindow;
  1041.     SetupRoiRect;
  1042.     if AutoSelectAll then
  1043.         KillRoi;
  1044. end;
  1045.  
  1046.  
  1047. procedure Convolve (name: str255; RefNum: integer);
  1048.     var
  1049.         kernel: ktype;
  1050.         n, count: integer;
  1051. begin
  1052.     if name = '' then begin
  1053.             RefNum := 0;
  1054.             if not GetTextFile(name, RefNum) then
  1055.                 exit(convolve)
  1056.             else
  1057.                 KernelsRefNum := RefNum;
  1058.         end;
  1059.     DisableDensitySlice;
  1060.     GetKernel(kernel, n, name, RefNum);
  1061.     count := n * n;
  1062.     UpdatePicWindow;
  1063.     if (n >= 3) and (n <= 63) then
  1064.         DoConvolution(kernel, n)
  1065.     else
  1066.         PutMessage('Kernels must be n x n square matrices with 3 <= n <= 63.');
  1067. end;
  1068.  
  1069.  
  1070. procedure ConvolveUsingText;
  1071.     var
  1072.         f: integer;
  1073.         err: OSErr;
  1074.         count: LongInt;
  1075. begin
  1076.     err := fsdelete('TempKernel', SystemRefNum);
  1077.     err := create('TempKernel', SystemRefNum, 'imag', 'TEXT');
  1078.     if err = NoErr then
  1079.         err := fsopen('TempKernel', SystemRefNum, f);
  1080.     if err <> NoErr then begin
  1081.             putmessage('Unable to open temporary file.');
  1082.             exit(ConvolveUsingText);
  1083.         end;
  1084.     if TextInfo <> nil then
  1085.         with TextInfo^ do begin
  1086.                 count := TextTE^^.TELength;
  1087.                 err := fswrite(f, count, TextTE^^.hText^);
  1088.                 err := fsclose(f);
  1089.                 Convolve('TempKernel', SystemRefNum);
  1090.                 err := fsdelete('TempKernel', SystemRefNum);
  1091.             end;
  1092. end;
  1093.  
  1094.  
  1095. function NewPicWindowD (name: str255): boolean;
  1096.     const
  1097.         WidthID = 5;
  1098.         HeightID = 6;
  1099.         TitleID = 8;
  1100.     var
  1101.         mylog: DialogPtr;
  1102.         item: integer;
  1103.         SaveWidth, SaveHeight: integer;
  1104.         okay: boolean;
  1105. begin
  1106.     if not macro and not OptionKeyWasDown then begin
  1107.             InitCursor;
  1108.             SaveWidth := NewPicWidth;
  1109.             SaveHeight := NewPicHeight;
  1110.             mylog := GetNewDialog(190, nil, pointer(-1));
  1111.             SetDNum(MyLog, WidthID, NewPicWidth);
  1112.             SelIText(MyLog, WidthID, 0, 32767);
  1113.             SetDNum(MyLog, HeightID, NewPicHeight);
  1114.             SetDString(MyLog, TitleID, name);
  1115.             OutlineButton(MyLog, ok, 16);
  1116.             repeat
  1117.                 ModalDialog(nil, item);
  1118.                 if item = WidthID then begin
  1119.                         NewPicWidth := GetDNum(MyLog, WidthID);
  1120.                         if (NewPicWidth < 0) or (NewPicWidth > MaxPicSize) then begin
  1121.                                 NewPicWidth := SaveWidth;
  1122.                                 SetDNum(MyLog, WidthID, NewPicWidth);
  1123.                             end;
  1124.                     end;
  1125.                 if item = HeightID then begin
  1126.                         NewPicHeight := GetDNum(MyLog, HeightID);
  1127.                         if (NewPicHeight < 0) or (NewPicHeight > MaxPicSize) then begin
  1128.                                 NewPicHeight := SaveHeight;
  1129.                                 SetDNum(MyLog, HeightID, NewPicHeight);
  1130.                             end;
  1131.                     end;
  1132.             until (item = ok) or (item = cancel);
  1133.             if item = ok then
  1134.                 name := GetDString(MyLog, TitleID);
  1135.             DisposDialog(mylog);
  1136.             if NewPicWidth < 32 then
  1137.                 NewPicWidth := 32;
  1138.             if odd(NewPicWidth) then
  1139.                 NewPicWidth := NewPicWidth + 1;
  1140.             if NewPicHeight < 16 then
  1141.                 NewPicHeight := 16;
  1142.             if item = cancel then begin
  1143.                     NewPicWidth := SaveWidth;
  1144.                     NewPicHeight := SaveHeight;
  1145.                     exit(NewPicWindowD);
  1146.                 end;
  1147.         end; {if not macro}
  1148.     NewPicWindowD := NewPicWindow(name, NewPicWidth, NewPicHeight);
  1149. end;
  1150.  
  1151.  
  1152. procedure PlotSurface;
  1153.     var
  1154.         hend, vend, h, v, DataWidth, DataHeight, i: integer;
  1155.         htemp, vtemp, ivalue: integer;
  1156.         skip, DataLeft, DataRight, DataTop, DataBottom: integer;
  1157.         hLoc, vLoc, hMin, hMax, vMin, vMax, MinIValue, MaxIValue: integer;
  1158.         hstart, vstart, dh, dv, hbase, vbase, vscale, nPlotLines, CalValue: extended;
  1159.         peak, MaxPeak, hinc, vinc, nLines, MinCValue, MaxCValue: extended;
  1160.         poly: PolyHandle;
  1161.         SaveInfo, PlotInfo: InfoPtr;
  1162.         aLine: LineType;
  1163.         MaskRect: rect;
  1164.         AutoSelectAll, ApplyLUT: boolean;
  1165.         table: LookupTable;
  1166.         StartTicks: LongInt;
  1167.  
  1168.     procedure FindVinc;
  1169.     begin
  1170.         with PlotInfo^.PicRect do begin
  1171.                 vstart := 5.0 + MaxPeak - dv * DataWidth;
  1172.                 skip := round(DataHeight / ((bottom - vstart - 5.0) / vinc));
  1173.                 if skip = 0 then
  1174.                     skip := 1;
  1175.                 nPlotLines := DataHeight / skip;
  1176.                 vinc := (bottom - vstart - 5.0) / nPlotLines;
  1177.                 vinc := vinc / 0.95;
  1178.                 repeat
  1179.                     vinc := vinc * 0.95;
  1180.                     hinc := vinc / 2.0;
  1181.                 until (5.0 + hinc * nPlotLines + dh * DataWidth) < right;
  1182.             end;
  1183.     end;
  1184.  
  1185. begin
  1186.     if NotRectangular or NotInBounds then
  1187.         exit(PlotSurface);
  1188.     StopDigitizing;
  1189.     DisableDensitySlice;
  1190.     SetForegroundColor(BlackIndex);
  1191.     SetBackgroundColor(WhiteIndex);
  1192.     SaveInfo := Info;
  1193.     if not NewPicWindowD('Surface Plot') then begin
  1194.             KillRoi;
  1195.             exit(PlotSurface)
  1196.         end;
  1197.     PlotInfo := info;
  1198.     info := SaveInfo;
  1199.     AutoSelectAll := not Info^.RoiShowing;
  1200.     ShowWatch;
  1201.     if AutoSelectAll then
  1202.         SelectAll(true);
  1203.     if TooWide then
  1204.         exit(PlotSurface);
  1205.     with info^ do
  1206.         ApplyLUT := ((LutMode = GrayScale) or (LutMode = CustomGrayscale)) and (not IdentityFunction);
  1207.     if ApplyLUT then
  1208.         GetLookupTable(table);
  1209.     Measure;
  1210.     UndoLastMeasurement(true);
  1211.     with results do begin
  1212.             MinIValue := MinIndex;
  1213.             MaxIValue := MaxIndex;
  1214.         end;
  1215.     if ApplyLut then begin
  1216.             MinIvalue := table[MinIValue];
  1217.             MaxIvalue := table[MaxIValue];
  1218.         end;
  1219.     MinCValue := 10e100;
  1220.     MaxCValue := -10e100;
  1221.     for i := MinIValue to MaxIValue do begin
  1222.             ivalue := i;
  1223.             if ApplyLUT then
  1224.                 ivalue := table[ivalue];
  1225.             calValue := cvalue[i];
  1226.             if calValue < minCValue then
  1227.                 minCValue := calValue;
  1228.             if calValue > maxCValue then
  1229.                 maxCValue := calValue;
  1230.         end;
  1231.     WhatToUndo := NothingToUndo;
  1232.     with results do
  1233.         if (MaxValue - MinValue) <> 0.0 then
  1234.             vscale := (255.0 / (MaxValue - MinValue)) * 0.5
  1235.         else
  1236.             vscale := 0.5;
  1237.     with info^.RoiRect do begin
  1238.             DataLeft := left;
  1239.             DataRight := right;
  1240.             DataTop := top;
  1241.             DataBottom := bottom;
  1242.             DataWidth := DataRight - DataLeft;
  1243.             DataHeight := DataBottom - DataTop;
  1244.         end;
  1245.     dh := (0.65 * PlotInfo^.PicRect.right) / DataWidth;
  1246.     dv := -0.4 * dh;
  1247.     hstart := 5.0;
  1248.     vinc := 2.0;
  1249.     MaxPeak := (MaxCValue - MinCValue) * vscale * 0.5;
  1250.     FindVinc; {First estimate}
  1251.     MaxPeak := MaxPeak * 2.0;
  1252.     hmin := DataRight + round(MaxPeak / dv);
  1253.     if hmin < 0 then
  1254.         hmin := 0;
  1255.     vmax := DataTop + round(MaxPeak / vinc);
  1256.     if vmax > DataBottom then
  1257.         vmax := DataBottom;
  1258.     MaxPeak := 0.0;
  1259.     vloc := DataTop;
  1260.     skip := 3;
  1261.     repeat
  1262.         hloc := hmin;
  1263.         repeat
  1264.             ivalue := MyGetPixel(hloc, vloc);
  1265.             if ApplyLUT then
  1266.                 ivalue := table[ivalue];
  1267.             calValue := cvalue[ivalue];
  1268.             peak := (calValue - MinCValue) * vscale + (DataRight - hloc) * dv - (vloc - DataTop) * vinc;
  1269.             if peak > MaxPeak then
  1270.                 MaxPeak := peak;
  1271.             hloc := hloc + skip;
  1272.         until hloc > DataRight;
  1273.         vloc := vloc + skip;
  1274.     until vloc > vmax;
  1275.     FindVinc;
  1276.     v := DataTop;
  1277.     StartTicks := TickCount;
  1278.     SetPort(GrafPtr(PlotInfo^.osPort));
  1279.     PenNormal;
  1280.     repeat
  1281.         hmax := 0;
  1282.         vmin := 9999;
  1283.         poly := OpenPoly;
  1284.         hbase := hstart;
  1285.         vbase := vstart;
  1286.         Info := SaveInfo;
  1287.         GetLine(DataLeft, v, DataWidth, aLine);
  1288.         info := PlotInfo;
  1289.         if ApplyLUT then
  1290.             ApplyTableToLine(@aLine, table, DataWidth);
  1291.         MoveTo(round(hbase), round(vbase - vscale * (cvalue[aLine[0]] - MinCValue)));
  1292.         for i := 0 to DataWidth - 1 do begin
  1293.                 hbase := hbase + dh;
  1294.                 vbase := vbase + dv;
  1295.                 hLoc := round(hbase);
  1296.                 vLoc := round(vbase - vscale * (cvalue[aLine[i]] - MinCValue));
  1297.                 LineTo(hloc, vloc);
  1298.                 if hloc > hmax then
  1299.                     hmax := hloc;
  1300.                 if vloc < vmin then
  1301.                     vmin := vloc;
  1302.             end;
  1303.         LineTo(round(hbase), round(vbase));
  1304.         LineTo(round(hstart), round(vstart));
  1305.         LineTo(round(hstart), round(vstart - vscale * (cvalue[aLine[0]] - MinCValue)));
  1306.         hmin := round(hstart);
  1307.         vmax := round(vstart);
  1308.         ClosePoly;
  1309.         ErasePoly(poly);
  1310.         FramePoly(poly);
  1311.         KillPoly(poly);
  1312.         SetRect(MaskRect, hmin, vmin, hmax, vmax);
  1313.         UpdateScreen(MaskRect);
  1314.         hstart := hstart + hinc;
  1315.         vstart := vstart + vinc;
  1316.         v := v + skip;
  1317.     until (v >= DataBottom) or CommandPeriod;
  1318.     ShowTime(StartTicks, SaveInfo^.RoiRect, '');
  1319.     if CommandPeriod then
  1320.         beep;
  1321.     info^.changes := true;
  1322. end;
  1323.  
  1324.  
  1325. procedure MakeSkeleton;
  1326. {This table-driven parallel thinning routine is based on an algorithm}
  1327. {by Zhang and Suen(CACM, March 1984, 236-239). There is}
  1328. {an entry in the table for each of the 256 possible 3x3 neighborhood}
  1329. {configurations. An entry of '1' means delete pixel on first pass, '2' means}
  1330. {delete pixel on second pass, and '3' means delete on either pass. There is a}
  1331. {routine in 'user.p' that will draw all 256 neighborhoods.}
  1332.     const
  1333.         s999 = '01234567890123456789012345678901';
  1334.         s000 = '00030033003130330000000030203033';
  1335.         s032 = '00000000300000003000000030003022';
  1336.         s064 = '00000000000000000000000000000000';
  1337.         s096 = '30000000200020003000000030003020';
  1338.         s128 = '03330013000000010000000000000001';
  1339.         s160 = '31000000000000002000000000000000';
  1340.         s192 = '33130013000000010000000000000000';
  1341.         s224 = '3301000100000000330100002200200';
  1342.     var
  1343.         table: FateTable;
  1344.         s: str255;
  1345.         i, pass: integer;
  1346. begin
  1347.     s := concat(s000, s032, s064, s096, s128, s160, s192, s224);
  1348.     for i := 0 to 254 do
  1349.         table[i] := ord(s[i + 1]) - ord('0');
  1350.     table[255] := 0;
  1351.     pass := 0;
  1352.     repeat
  1353.         PixelsRemoved := 0;
  1354.         filter(skeletonize, pass, table);
  1355.         pass := pass + 1;
  1356.         if not CommandPeriod then
  1357.             filter(skeletonize, pass, table);
  1358.         pass := pass + 1;
  1359.     until (PixelsRemoved = 0) or CommandPeriod;
  1360. end;
  1361.  
  1362.  
  1363. procedure DoErosion;
  1364.     var
  1365.         i: integer;
  1366.         t: FateTable;
  1367. begin
  1368.     for i := 0 to BinaryIterations - 1 do begin
  1369.             filter(Erosion, i, t);
  1370.             if CommandPeriod then
  1371.                 leave;
  1372.         end;
  1373. end;
  1374.  
  1375.  
  1376. procedure DoDilation;
  1377.     var
  1378.         i: integer;
  1379.         t: FateTable;
  1380. begin
  1381.     for i := 0 to BinaryIterations - 1 do begin
  1382.             filter(Dilation, i, t);
  1383.             if CommandPeriod then
  1384.                 leave;
  1385.         end;
  1386. end;
  1387.  
  1388.  
  1389. procedure DoOpening;
  1390.     var
  1391.         i: integer;
  1392.         t: FateTable;
  1393. begin
  1394.     for i := 0 to BinaryIterations - 1 do begin
  1395.             filter(Erosion, i, t);
  1396.             if CommandPeriod then
  1397.                 exit(DoOpening);
  1398.         end;
  1399.     for i := 0 to BinaryIterations - 1 do begin
  1400.             filter(Dilation, i + BinaryIterations, t);
  1401.             if CommandPeriod then
  1402.                 exit(DoOpening);
  1403.         end;
  1404. end;
  1405.  
  1406. procedure DoClosing;
  1407.     var
  1408.         i: integer;
  1409.         t: FateTable;
  1410. begin
  1411.     for i := 0 to BinaryIterations - 1 do begin
  1412.             filter(Dilation, i, t);
  1413.             if CommandPeriod then
  1414.                 exit(DoClosing);
  1415.         end;
  1416.     for i := 0 to BinaryIterations - 1 do begin
  1417.             filter(Erosion, i + BinaryIterations, t);
  1418.             if CommandPeriod then
  1419.                 exit(DoClosing);
  1420.         end;
  1421. end;
  1422.  
  1423. procedure SetBinaryCount;
  1424.     var
  1425.         TempCount: integer;
  1426.         Canceled: boolean;
  1427. begin
  1428.     TempCount := GetInt('Neighborhood Pixel Count(1-8):', BinaryCount, Canceled);
  1429.     if Canceled then
  1430.         exit(SetBinaryCount);
  1431.     if (TempCount >= 1) and (TempCount <= 8) then begin
  1432.             BinaryCount := TempCount;
  1433.             BinaryThreshold := BinaryCount * 255
  1434.         end
  1435.     else
  1436.         beep;
  1437. end;
  1438.  
  1439. procedure SetIterations;
  1440.     var
  1441.         TempIterations: integer;
  1442.         Canceled: boolean;
  1443. begin
  1444.     TempIterations := GetInt('Number of Iterations:', BinaryIterations, Canceled);
  1445.     if Canceled then
  1446.         exit(SetIterations);
  1447.     if (TempIterations >= 1) and (TempIterations < 100) then
  1448.         BinaryIterations := TempIterations
  1449.     else
  1450.         beep;
  1451. end;
  1452.  
  1453.  
  1454. procedure ChangeValues (v1, v2, v3: integer);
  1455.       {Changes all pixels in the current selection with a value in the range v1 to v2 to a value of v3.}
  1456.     var
  1457.         i, value: integer;
  1458.         table: LookupTable;
  1459. begin
  1460.     for i := 0 to 255 do begin
  1461.             value := i;
  1462.             if (value >= v1) and (value <= v2) then
  1463.                 value := v3;
  1464.             table[i] := value;
  1465.         end;
  1466.     ApplyTable(table);
  1467. end;
  1468.  
  1469.  
  1470. procedure DoPropagate (MenuItem: integer);
  1471.       {Copies the current Look-Up Table, spatial calibration, or density calibration to all open windows.}
  1472.     var
  1473.         TempInfo: InfoPtr;
  1474.         i: integer;
  1475.  
  1476.     procedure CopyLUTInfo;
  1477.     begin
  1478.         with info^ do begin
  1479.                 TempInfo^.RedLUT := RedLUT;
  1480.                 TempInfo^.GreenLUT := GreenLUT;
  1481.                 TempInfo^.BlueLUT := BlueLUT;
  1482.                 TempInfo^.ColorStart := ColorStart;
  1483.                 TempInfo^.ColorEnd := ColorEnd;
  1484.                 TempInfo^.nColors := nColors;
  1485.                 TempInfo^.LutMode := LUTMode;
  1486.                 TempInfo^.cTable := cTable;
  1487.                 TempInfo^.FillColor1 := FillColor1;
  1488.                 TempInfo^.FillColor2 := FillColor2;
  1489.                 TempInfo^.FillColor1 := FillColor1;
  1490.                 TempInfo^.SaveFill1 := SaveFill1;
  1491.                 TempInfo^.SaveFill2 := SaveFill2;
  1492.             end;
  1493.     end;
  1494.  
  1495.     procedure CopySpatialCalibration;
  1496.         var
  1497.             SaveInfo: InfoPtr;
  1498.     begin
  1499.         with info^ do begin
  1500.                 TempInfo^.xSpatialScale := xSpatialScale;
  1501.                 TempInfo^.ySpatialScale := ySpatialScale;
  1502.                 TempInfo^.PixelAspectRatio := PixelAspectRatio;
  1503.                 TempInfo^.RawspatialScale := RawspatialScale;
  1504.                 TempInfo^.ScaleMagnification := ScaleMagnification;
  1505.                 TempInfo^.Units := Units;
  1506.                 TempInfo^.UnitsID := UnitsID;
  1507.                 TempInfo^.FullUnits := FullUnits;
  1508.                 TempInfo^.changes := true;
  1509.                 TempInfo^.SpatiallyCalibrated := SpatiallyCalibrated;
  1510.             end;
  1511.         SaveInfo := Info;
  1512.         Info := TempInfo;
  1513.         UpdateTitleBar;
  1514.         Info := SaveInfo;
  1515.     end;
  1516.  
  1517.     procedure CopyDensityCalibration;
  1518.         var
  1519.             SaveInfo: InfoPtr;
  1520.     begin
  1521.         with info^ do begin
  1522.                 TempInfo^.DensityCalibrated := DensityCalibrated;
  1523.                 TempInfo^.ZeroClip := ZeroClip;
  1524.                 TempInfo^.fit := fit;
  1525.                 TempInfo^.nCoefficients := nCoefficients;
  1526.                 TempInfo^.Coefficient := Coefficient;
  1527.                 TempInfo^.UnitOfMeasure := UnitOfMeasure;
  1528.                 TempInfo^.changes := true;
  1529.             end;
  1530.         SaveInfo := Info;
  1531.         Info := TempInfo;
  1532.         UpdateTitleBar;
  1533.         Info := SaveInfo;
  1534.     end;
  1535.  
  1536. begin
  1537.     for i := 1 to nPics do begin
  1538.             TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
  1539.             case MenuItem of
  1540.                 1: 
  1541.                     CopyLUTInfo;
  1542.                 2: 
  1543.                     CopySpatialCalibration;
  1544.                 3: 
  1545.                     CopyDensityCalibration;
  1546.             end; {case}
  1547.         end;
  1548.     WhatToUndo := NothingToUndo;
  1549. end;
  1550.  
  1551. procedure DoArithmetic (MenuItem: integer; constant: extended);
  1552.     var
  1553.         table: LookupTable;
  1554.         i: integer;
  1555.         tmp: LongInt;
  1556.         LogScale: extended;
  1557.         Canceled: boolean;
  1558. begin
  1559.     canceled := false;
  1560.     if not macro then
  1561.         case menuItem of
  1562.             AddItem: 
  1563.                 constant := GetReal('Constant to add:', 25, Canceled);
  1564.             SubtractItem: 
  1565.                 constant := GetReal('Constant to subtract:', 25, Canceled);
  1566.             MultiplyItem:  begin
  1567.                     constant := GetReal('Constant to multiply by:', 1.25, Canceled);
  1568.                     if constant < 0.0 then begin
  1569.                             PutMessage('Constant must be positive.');
  1570.                             exit(DoArithmetic);
  1571.                         end;
  1572.                 end;
  1573.             DivideItem:  begin
  1574.                     constant := GetReal('Constant to divide by:', 1.25, Canceled);
  1575.                     if constant <= 0.0 then begin
  1576.                             PutMessage('Constant must be nonzero and positive.');
  1577.                             exit(DoArithmetic);
  1578.                         end;
  1579.                 end;
  1580.             LogItem:  begin
  1581.                     constant := 0.0;
  1582.                     LogScale := 255.0 / ln(255.0);
  1583.                 end;
  1584.         end; {case}
  1585.     if Canceled then
  1586.         exit(DoArithmetic);
  1587.     for i := 0 to 255 do begin
  1588.             case MenuItem of
  1589.                 AddItem: 
  1590.                     tmp := round(i + constant);
  1591.                 SubtractItem: 
  1592.                     tmp := round(i - constant);
  1593.                 MultiplyItem: 
  1594.                     tmp := round(i * constant);
  1595.                 DivideItem: 
  1596.                     tmp := round(i / constant);
  1597.                 LogItem: 
  1598.                     if i = 0 then
  1599.                         tmp := 0
  1600.                     else
  1601.                         tmp := round(ln(i) * LogScale);
  1602.             end;
  1603.             if tmp < 0 then
  1604.                 tmp := 0;
  1605.             if tmp > 255 then
  1606.                 tmp := 255;
  1607.             table[i] := tmp;
  1608.         end;
  1609.     ApplyTable(table);
  1610. end;
  1611.  
  1612.  
  1613. procedure AutoThreshold;
  1614.        {Iterative thresholding technique, described originally by Ridler & Calvard in}
  1615.        {"PIcture Thresholding Using an Iterative Selection Method", IEEE transactions}
  1616.        { on Systems, Man and Cybernetics, August, 1978. }
  1617.     var
  1618.         AutoSelectAll, SaveRedirectFlag: boolean;
  1619.         index, MovingIndex, level: integer;
  1620.         tempSum1, tempSum2, tempSum3, tempSum4, result: extended;
  1621. begin
  1622.     AutoSelectAll := not info^.RoiShowing;
  1623.     if AutoSelectAll then
  1624.         SelectAll(false);
  1625.     SaveRedirectFlag := RedirectSampling;
  1626.     RedirectSampling := false;
  1627.     if info^.RoiType = RectRoi then
  1628.         GetRectHistogram
  1629.     else
  1630.         GetHistogram;
  1631.     RedirectSampling := SaveRedirectFlag;
  1632.     OptionKeyWasDown := OptionKeyDown;
  1633.     if not OptionKeyWasDown then begin
  1634.               {Default is to set to these to null so erased areas won't be included in the threshold }
  1635.             Histogram[0] := 0;
  1636.             Histogram[255] := 0;
  1637.         end;
  1638.     with Results do begin {From ComputeResults}
  1639.             MinIndex := 0;
  1640.             while (histogram[MinIndex] = 0) and (MinIndex < 255) do
  1641.                 MinIndex := MinIndex + 1;
  1642.             MaxIndex := 255;
  1643.             while (histogram[MaxIndex] = 0) and (MaxIndex > 0) do
  1644.                 MaxIndex := MaxIndex - 1;
  1645.             if (MinIndex >= MaxIndex) then begin
  1646.                     level := 128;
  1647.                     ShowMessage(concat('Threshold=', Long2Str(level)));
  1648.                     EnableThresholding(level);
  1649.                     exit(AutoThreshold);
  1650.                 end;
  1651.             MovingIndex := MinIndex;
  1652.             repeat
  1653.                 tempSum1 := 0;
  1654.                 tempSum2 := 0;
  1655.                 tempSum3 := 0;
  1656.                 tempSum4 := 0;
  1657.                 for index := MinIndex to MovingIndex do begin
  1658.                         tempSum1 := tempSum1 + index * Histogram[index];
  1659.                         tempSum2 := tempSum2 + Histogram[index];
  1660.                     end;
  1661.                 for index := (MovingIndex + 1) to MaxIndex do begin
  1662.                         tempSum3 := tempSum3 + index * Histogram[index];
  1663.                         tempSum4 := tempSum4 + Histogram[index];
  1664.                     end;
  1665.                 Result := (tempSum1 / TempSum2 / 2) + (tempSum3 / tempSum4 / 2);
  1666.                 MovingIndex := MovingIndex + 1;
  1667.             until ((MovingIndex + 1) > result) or (MovingIndex > (MaxIndex - 1));
  1668.             level := Round(result);
  1669.             EnableThresholding(level);
  1670.             ShowMessage(concat('Threshold=', Long2Str(level)));
  1671.         end; {with}
  1672. end;
  1673.  
  1674.  
  1675. procedure AutoDensitySlice;
  1676.     var
  1677.         AutoSelectAll: boolean;
  1678.         sigmak1k2, sigmax, nsum: real;
  1679.         i, j, maxk1, maxk2, temp: integer;
  1680.         musubt, omegak1, omegak2, muk1, muk2: real;
  1681.         part1, part2, part3: real;
  1682.         intermed1, intermed2, intermed3: real;
  1683. begin
  1684.     ResetGrayMap;
  1685.     AutoSelectAll := not info^.RoiShowing;
  1686.     if AutoSelectAll then
  1687.         SelectAll(false);
  1688.     if info^.RoiType = RectRoi then
  1689.         GetRectHistogram
  1690.     else
  1691.         GetHistogram;
  1692.     maxk1 := 0;
  1693.     maxk2 := 0;
  1694.     musubt := 0.0;
  1695.     nsum := 0.0;
  1696.     for i := 1 to 254 do begin
  1697.             nsum := nsum + histogram[i];
  1698.         end;
  1699.     for i := 1 to 254 do begin
  1700.             musubt := musubt + (i * (histogram[i] / nsum));
  1701.         end;
  1702.     sigmak1k2 := 0.0;
  1703.     sigmax := 0.0;
  1704.     omegak1 := 0.0;
  1705.     muk1 := 0.0;
  1706.     for i := 1 to 253 do begin
  1707.             temp := i + 1;
  1708.             omegak2 := 0.0;
  1709.             muk2 := 0.0;
  1710.             omegak1 := omegak1 + (histogram[i] / nsum);
  1711.             muk1 := muk1 + (i * (histogram[i] / nsum));
  1712.             if omegak1 > 0.0 then begin
  1713.                     for j := temp to 254 do begin
  1714.                             omegak2 := omegak2 + (histogram[j] / nsum);
  1715.                             muk2 := muk2 + (j * (histogram[j] / nsum));
  1716.                             if omegak1 * omegak2 * (1.0 - omegak1 - omegak2) > 0.0 then begin
  1717.                                     part1 := ((omegak1 * muk2) - (omegak2 * muk1)) * ((omegak1 * muk2) - (omegak2 * muk1));
  1718.                                     intermed1 := omegak2 * omegak1;
  1719.                                     part2 := ((omegak1 * (musubt - muk2)) - (muk1 * (1 - omegak2))) * ((omegak1 * (musubt - muk2)) - (muk1 * (1 - omegak2)));
  1720.                                     intermed2 := omegak1 * (1 - omegak1 - omegak2);
  1721.                                     part3 := ((omegak2 * (musubt - muk1)) - (muk2 * (1 - omegak1))) * ((omegak2 * (musubt - muk1)) - (muk2 * (1 - omegak1)));
  1722.                                     intermed3 := omegak2 * (1 - omegak1 - omegak2);
  1723.                                     if intermed1 * intermed2 * intermed3 > 0.0 then begin
  1724.                                             sigmak1k2 := part1 / intermed1 + part2 / intermed2 + part3 / intermed3;
  1725.                                         end;
  1726.                                 end;
  1727.                             if sigmak1k2 > sigmax then begin
  1728.                                     maxk1 := i;
  1729.                                     maxk2 := j;
  1730.                                     sigmax := sigmak1k2;
  1731.                                 end;
  1732.                         end;
  1733.                 end;
  1734.         end;
  1735.     SliceStart := maxk1;
  1736.     SliceEnd := maxk2;
  1737. end;
  1738.  
  1739.  
  1740. procedure FixColors;
  1741.     {Because Image always sets LUT entries 0 and 255 to white and black respectively we need to map}
  1742.     {pixels with values of 0 or 255 to the nearest matching color in the other 254  LUT entries.}
  1743.     var
  1744.         i, index2, match0, match255: integer;
  1745.         table: LookupTable;
  1746.  
  1747.     procedure BestMatch (index1: integer; var match: integer);
  1748.         var
  1749.             i: integer;
  1750.             rdiff, gdiff, bdiff: LongInt;
  1751.             diff, mindiff: extended;
  1752.     begin
  1753.         match := index1;
  1754.         mindiff := 10e10;
  1755.         if index1 = 0 then
  1756.             index2 := 1
  1757.         else
  1758.             index2 := 254;
  1759.         with info^ do
  1760.             for i := 1 to 254 do begin
  1761.                     rdiff := bsr(cTable[index1].rgb.red, 8) - bsr(cTable[index2].rgb.red, 8);
  1762.                     gdiff := bsr(cTable[index1].rgb.green, 8) - bsr(cTable[index2].rgb.green, 8);
  1763.                     bdiff := bsr(cTable[index1].rgb.blue, 8) - bsr(cTable[index2].rgb.blue, 8);
  1764.                     diff := sqrt(sqr(rdiff) + sqr(gdiff) + sqr(bdiff));
  1765.                     if diff < mindiff then begin
  1766.                             match := index2;
  1767.                             mindiff := diff;
  1768.                         end;
  1769.                     if index1 = 0 then
  1770.                         index2 := index2 + 1
  1771.                     else
  1772.                         index2 := index2 - 1;
  1773.                 end;
  1774.     end;
  1775.  
  1776. begin
  1777.     BestMatch(0, match0);
  1778.     BestMatch(255, match255);
  1779.     table[0] := match0;
  1780.     for i := 1 to 254 do
  1781.         table[i] := i;
  1782.     table[255] := match255;
  1783.     ApplyTable(table);
  1784. end;
  1785.  
  1786.  
  1787. procedure GetDItemRect (d: DialogPtr; item: integer; var r: rect);
  1788.     var
  1789.         iType: integer;
  1790.         ignore: handle;
  1791. begin
  1792.     GetDItem(d, item, itype, ignore, r)
  1793. end;
  1794.  
  1795.  
  1796. procedure DrawPopUpText (str: str255; r: rect);
  1797. begin
  1798.     TextFont(SystemFont);
  1799.     if (str = '+') or (str = '–') or (str = '÷') then begin
  1800.             TextSize(24);
  1801.             MoveTo(r.left + 13, r.bottom - 2);
  1802.         end
  1803.     else begin
  1804.             TextSize(12);
  1805.             MoveTo(r.left + 13, r.bottom - 5);
  1806.         end;
  1807.     DrawString(str);
  1808. end;
  1809.  
  1810.  
  1811. procedure ImageMathUProc (d: DialogPtr; item: integer);
  1812.      {User proc for Image Math dialog box}
  1813.     var
  1814.         str: str255;
  1815.         VersInfo: str255;
  1816.         r: rect;
  1817. begin
  1818.     SetPort(d);
  1819.     GetDItemRect(d, item, r);
  1820.     DrawDropBox(r);
  1821.     case item of
  1822.         OpItem:  begin
  1823.                 GetItem(ImageMathOpsMenuH, ord(CurrentMathOp) + 1, str);
  1824.                 DrawPopUpText(str, r);
  1825.             end;
  1826.     end;
  1827. end;
  1828.  
  1829.  
  1830. procedure SetUProc (d: DialogPtr; item: integer; pptr: handle);
  1831.     var
  1832.         itype: integer;
  1833.         r: rect;
  1834.         h: handle;
  1835. begin
  1836.     GetDItem(d, item, itype, h, r);
  1837.     SetDItem(d, item, itype, pptr, r);
  1838. end;
  1839.  
  1840.  
  1841. procedure DoImageMath;
  1842.     const
  1843.         ScaleItem = 10;
  1844.         OffsetItem = 11;
  1845.         ResultItem = 12;
  1846.     var
  1847.         d: DialogPtr;
  1848.         item, i, MenuItem: integer;
  1849.         r: rect;
  1850.         str: str255;
  1851. begin
  1852.     InitCursor;
  1853.     d := GetNewDialog(200, nil, pointer(-1));
  1854.     SetUProc(d, Src1Item, @ImageMathUProc);
  1855.     SetUProc(d, Src2Item, @ImageMathUProc);
  1856.     SetUProc(d, OpItem, @ImageMathUProc);
  1857.     repeat
  1858.         if item = OpItem then begin
  1859.                 setport(d);
  1860.                 GetDItemRect(d, item, r);
  1861.                 MenuItem := PopUpMenu(ImageMathOpsMenuH, r.left, r.top, ord(CurrentMathOp) + 1);
  1862.                 case MenuItem of
  1863.                     1: 
  1864.                         CurrentMathOp := AddMath;
  1865.                     2: 
  1866.                         CurrentMathOp := SubMath;
  1867.                     3: 
  1868.                         CurrentMathOp := MulMath;
  1869.                     4: 
  1870.                         CurrentMathOp := DivMath;
  1871.                     5: 
  1872.                         CurrentMathOp := AndMath;
  1873.                     6: 
  1874.                         CurrentMathOp := OrMath;
  1875.                     7: 
  1876.                         CurrentMathOp := XorMath;
  1877.                     8: 
  1878.                         CurrentMathOp := MaxMath;
  1879.                     9: 
  1880.                         CurrentMathOp := MinMath;
  1881.                     10: 
  1882.                         CurrentMathOp := CopyMath;
  1883.                 end;
  1884.                 DrawDropBox(r);
  1885.                 GetItem(ImageMathOpsMenuH, ord(CurrentMathOp) + 1, str);
  1886.                 DrawPopUpText(str, r);
  1887.             end;
  1888.         ModalDialog(nil, item);
  1889.     until (item = ok) or (item = cancel);
  1890.     DisposDialog(d);
  1891.     if item = cancel then
  1892.         exit(DoImageMath);
  1893. end;
  1894.  
  1895.  
  1896. end.